REBOL [
	Title: "RebGUI system"
	Owner: "Ashley G Truter"
	Purpose: "Creates the RebGUI context and associated global functions."
]

;	colors are in descending order of brightness

system/locale: make system/locale [
	colors: [black navy blue violet forest maroon coffee purple reblue coal oldrab red brick crimson leaf brown aqua teal magenta sienna water olive papaya mint gray rebolor green orange pewter base-color khaki cyan tan silver pink sky gold wheat yellow yello beige snow linen ivory white]
	words: []
	language: "English"
	dictionary: none
	dict: none
]

win-offset?: make function! [
	"Returns the offset of a face within its window."
	face [object!]
	/local xy
][
	xy: 0x0
	while [face/parent-face] [
		xy: xy + face/offset
		face: face/parent-face
		if face/edge [xy: xy + face/edge/size]
	]
	xy
]

within?: make function! [
	"Return TRUE if the point is within the rectangle bounds."
	point [pair!] "XY position"
	offset [pair!] "Offset of area"
	size [pair!] "Size of area"
][
	all [
		point/x >= offset/x
		point/y >= offset/y
		offset/x + size/x > point/x
		offset/y + size/y > point/y
	]
]

;
;	--- RebGUI context ---
;

ctx-rebgui: make object! [

	OS: switch fourth system/version [2 ['Mac] 3 ['Win] true ['Nix]]
	build: 218
	view*: system/view
	screen*: view*/screen-face
	locale*: system/locale

	screen*/color: screen*/edge: screen*/font: screen*/para: screen*/feel: none

	view*/VID:
	view*/popface-feel:
	view*/popface-feel-nobtn:
	view*/popface-feel-away:
	view*/popface-feel-away-nobtn:
	view*/popface-feel-win:
	view*/popface-feel-win-nobtn:
	view*/popface-feel-win-away:
	view*/popface-feel-win-away-nobtn: none
	
	;
	;	Internal helper functions
	;

	second-last: make function! [
		"Returns the second last value of a series."
		block [block!]
	] [
		pick tail block -2
	]

	range: make function! [
		"Returns a number bounded by floor and ceiling."
		floor [integer!]
		ceiling [integer!]
		number [integer! decimal!]
	][
		max floor min ceiling number
	]

	sjoin: make function! [
		"Concatenates values."
		value "Base value"
		rest "Value or block of values"
	][
		either series? value [
			make type? value reduce [value rest]
		][
			make string! reduce [value rest]
		]
	]

	srejoin: make function! [
		"Reduces and joins a block of values."
		block [block!] "Values to reduce and join"
	][
		either empty? block: reduce block [block] [
			make either series? first block [type? first block] [string!] block
		]
	]

	;	handles #HWXY span directives

	span-resize: make function! [face [object!] delta [pair!]] [
		if face/span [
			face/old-size: face/size
			all [find face/span #X face/offset/x: face/offset/x + delta/x]
			all [find face/span #Y face/offset/y: face/offset/y + delta/y]
			all [find face/span #W face/size/x: face/size/x + delta/x]
			all [find face/span #H face/size/y: face/size/y + delta/y]
			all [face/type <> 'face-iterator face/old-size <> face/size object? get in face 'action face/action/on-resize face]
		]
		;	pane could be an iterator function
		any [
			all [block? get in face 'pane foreach f face/pane [span-resize f delta]]
			all [object? get in face 'pane span-resize face/pane delta]
		]
	]

	;	handles #LV span directives

	span-R: 0

	span-init: make function! [face [object!] size [pair!] margin [pair!]] [
		if face/span [
			if find face/span #L [
				face/size/x: size/x - face/offset/x - margin/x
				all [face/type <> 'face-iterator get in face 'action face/action/on-resize face]
			]
			if find face/span #V [
				face/size/y: size/y - face/offset/y - margin/y
				all [face/type <> 'face-iterator get in face 'action face/action/on-resize face]
			]
			either find face/span #R [
				span-R: face/offset/x
				face/offset/x: size/x - face/size/x - margin/x
				span-R: face/offset/x - span-R
			] [
				all [
					find face/span #O
					face/offset/x: face/offset/x + span-R
				]
			]
		]
		any [
			all [block? get in face 'pane either face/type = 'tab-panel [
					foreach f face/pane [span-init f face/size 0x0]
				] [
					foreach f face/pane [span-init f face/size face/pane/1/offset]
				]
			]
			all [object? get in face 'pane span-init face/pane face/size face/pane/offset]
		]
	]

	words: [after at bold button-size data disable do edge effect feel field-size font indent italic label-size margin on on-alt-click on-away on-click on-dbl-click on-edit on-focus on-key on-over on-resize on-scroll on-time on-unfocus options pad para rate return reverse space text-color text-size tight underline]

	;
	;	--- Hilight funcs ---
	;

	select-face: make function! [face] [
		face/font/color: colors/edit
		set-color face colors/theme/3
	]

	deselect-face: make function! [face /no-show] [
		face/font/color: colors/text
		set-color/no-show/deselect face none
		unless no-show [show face]
	]

	;
	;	Attribute tests
	;

	attribute-old-color?: make function! [
		face
		/only "Return true if present but none"
	] [
		all [in face 'old-color any [face/old-color either only [true] [none]]]
	]

	;
	;	UI Definitions
	;

	colors: make object! [
		page: either OS = 'Mac [232.232.232] [white]
		edit: white
		text: black
		true: leaf
		false: red
		link: blue
		theme: [165.217.246 0.105.207 0.55.155]
		outline: [207.207.207 160.160.160 112.112.112]
	]

	sizes: make object! [
		cell: 4
		font: 12 ; pt size
		font-height: none ; pixel height - set by widget init code
		gap: 2
		line: cell * 5
		margin: 4
		slider: cell * 4
		gap-size: cell * as-pair gap gap
		margin-size: cell * as-pair margin margin
	]

	behaviors: make object! [
		action-on-enter: [drop-list edit-list field password spinner]
		action-on-tab: [field]
		caret-on-focus: [area]
		hilight-on-focus: [edit-list field password spinner]
		tabbed: [area button drop-list edit-list field password spinner table text-list tree]
	]

	effects: make object! [
		radius: either OS = 'Mac [to integer! sizes/line / 2] [2]
		font: select [Mac "Lucida Grande" Win "Verdana" Nix "Helvetica"] OS
		splash-delay: 1
		window: none
	]
	
	on-error: make object! [
		email: none
		subject: "RebGUI Error Report"
	]

	fonts: copy []

	on-fkey: make object! [
		f1: f2: f3: f4: f5: f6: f7: f8: f9: f10: f11: f12: none
	]

	disable-widgets: copy [] ; list of layout widgets that display should disable

	#include %rebgui-edit.r
	#include %rebgui-functions.r
	#include %rebgui-images.r
	#include %rebgui-widgets.r
	#include %rebgui-requestors.r

	set-locale none ; set locale
	insert tail words next find first widgets 'choose ; add widget names to words
]

open-events ; needed in case we are running from rebface / enface
recycle ; free unused memory